¿Qué datos son?
La base posee datos sobre diferentes vinos y sus reseñas. El detalle de los datos se transcribe del diccionario:
diccionario <- data.frame(
Variable = c("pais", "nombre", "puntos", "precio", "provincia", "zona_1", "zona_2", "variedad", "vina", "titulo_resena"),
Clase = c("caracter", "caracter", "entero", "entero", "caracter", "caracter", "caracter", "caracter", "caracter", "caracter"),
Descripción = c("País de origen", "Nombre del vino", "Puntos con que fue calificado (1 a 100)", "Precio de la botella (en dólares)",
"Lugar de origen", "Información adicional sobre zona de origen", "Más información adicional",
"Variedad (ie, Pinot Noir)", "Nombre de la viña", "Título de la reseña")
)
dicc_url = "https://github.com/cienciadedatos/datos-de-miercoles/tree/master/datos/2019/2019-06-12"
dicc_pie = "Fuente: '<a href=\"dicc_url\">Datos de Miércoles</a>', proyecto semanal de datos organizado por la comunidad de R."
diccionario |>
gt(rowname_col = "Variable") |>
tab_options(table.width = "75%") |>
opt_stylize(style = 5, color = 'green') |>
# tab_stubhead(label = "Variable") |>
# gt_theme_dark() |>
tab_source_note(html(dicc_pie))| Clase | Descripción | |
|---|---|---|
| pais | caracter | País de origen |
| nombre | caracter | Nombre del vino |
| puntos | entero | Puntos con que fue calificado (1 a 100) |
| precio | entero | Precio de la botella (en dólares) |
| provincia | caracter | Lugar de origen |
| zona_1 | caracter | Información adicional sobre zona de origen |
| zona_2 | caracter | Más información adicional |
| variedad | caracter | Variedad (ie, Pinot Noir) |
| vina | caracter | Nombre de la viña |
| titulo_resena | caracter | Título de la reseña |
| Fuente: 'Datos de Miércoles', proyecto semanal de datos organizado por la comunidad de R. | ||
¿De dónde provienen?
La fuente de los datos es la revista Wine Enthusiast, extraidos por zackthoutt y alojados en Kaggle, de donde fueron tomados y luego traducidos.
¿Quién los tomó?
¿En qué período se tomaron?
El dataset en español es de 2019-06-12 (dato obtenido de la url de origen del dataset).
El original en inglés de Keggle fue actualizado por última vez hace 5 años (2018), pero no se indica la fecha exacta de procedencia de los datos.
Exploración de los datos
Primero se cargan los datos:
Luego se presenta una muestra:
sample_n(vinos, 5) |>
gt() |>
# tab_options(table.background.color = "#25303f",
# heading.background.color = "#003258") |>
gt_theme_pff() |>
# gt_highlight_cols(columns = c(puntos,precio), fill = "#e4e8ec") |>
tab_header(title = "Reseñas de Vinos") |>
tab_footnote(
footnote = "Muestra aleatoria de 5 registros.",
locations = cells_title("title")) |>
tab_source_note(
source_note = html("Fuente: Revista <a href=\"www.wineenthusiast.com\">Wine Enthusiast</a>."))| Reseñas de Vinos1 | |||||||||
| pais | nombre | puntos | precio | provincia | region_1 | region_2 | variedad | vina | titulo_resena |
|---|---|---|---|---|---|---|---|---|---|
| Chile | Reserva lo Mejor Illusión | 86 | 14 | Valle del Bío Bío | NA | NA | Chardonnay | Gracia de Chile | Gracia de Chile 2007 Reserva lo Mejor Illusión Chardonnay (Bío Bío Valley) |
| Francia | Intense | 85 | 13 | Bordeaux | Bordeaux Blanc | NA | Bordeaux-style White Blend | Château Lamothe-Vincent | Château Lamothe-Vincent 2015 Intense (Bordeaux Blanc) |
| Estados Unidos | No. 254 | 91 | 65 | California | Napa Valley | Napa | Meritage | Louis M. Martini | Louis M. Martini 2013 No. 254 Meritage (Napa Valley) |
| Alemania | Graacher Himmelreich Vat 46 Eiswein | 93 | 143 | Mosel-Saar-Ruwer | NA | NA | Riesling | S.A. Prüm | S.A. Prüm 2001 Graacher Himmelreich Vat 46 Eiswein Riesling (Mosel-Saar-Ruwer) |
| Argentina | Primogénito | 88 | 22 | Otra | Patagonia | NA | Malbec | Bodega Patritti | Bodega Patritti 2008 Primogénito Malbec (Patagonia) |
| Fuente: Revista Wine Enthusiast. | |||||||||
| 1 Muestra aleatoria de 5 registros. | |||||||||
Se almacenan las dimensiones de la base en variables:
El dataset tiene 129971 observaciones y 10
variables.
Se consideran las variables puntos y precio
para el análisis, ya que son las únicas numéricas, por lo que permiten
mayores análisis que el resto de las variables del dataset, que son
categóricas.
¿Cuál es su valor medio y desvío estándar?
| Medidas de Tendencia Central | ||||
| Media | Mediana | Moda | Desvío | |
|---|---|---|---|---|
| Puntos | 88.45 | 88 | 88 | 3.04 |
| Precio | 35.36 | 25 | 20 | 41.02 |
Puntos
Por la media y el desvío, se puede estimar, asumiendo que las
calificaciones tienen distribución normal, que el 68% de la muestra se
encuentra entre 85 y 91 puntos.
La similitud entre media, mediana y moda permite suponer una distribución, si no normal, al menos simétrica.
Precio
Por la media y el desvío, se puede suponer que la distribución no es normal.
La diferencia entre moda, mediana y media, confirma esto, permitiendo estimar una distribución asimétrica hacia la derecha.
¿Cuál es su rango (valor máximo y valor mínimo)?
pts_rng <- summarise(vinos,
min = min(puntos, na.rm = TRUE),
max = max(puntos, na.rm = TRUE))
pre_rng <- summarise(vinos,
min = min(precio, na.rm = TRUE),
max = max(precio, na.rm = TRUE))
rng <- rbind(pts_rng, pre_rng) |>
add_column("variable" = c("Puntos","Precio"),
.before = "min") |>
gt(rowname_col = 'variable') |>
tab_header(
title = "Rango") |>
cols_label(min = "Mínimo",
max = "Máximo") |>
opt_stylize(style = 2, color = 'blue')
rng| Rango | ||
| Mínimo | Máximo | |
|---|---|---|
| Puntos | 80 | 100 |
| Precio | 4 | 3300 |
Puntos
Puede observarse que los puntos no bajan de 80, por lo
que la calificación oscila en un rango de solo 20
puntos.
Precio
Se confirma que los precios altos tienen gran dispersión y se alejan mucho de la media, lo que ratifica una asimetría hacia la derecha.
¿Hay alguna anomalía que sugiera que hay datos incorrectos?
No hay evidencias de que existan anomalías en los datos, solo algunos
valores llamativos, como la diferencia entre la media de precios y los
precios máximos, ya que, aunque el máximo es US$3300, solo
existen 1177 (de un total de 129971) que
superen los US$158 (promedio de precio + 3 desvíos
estándar).
También llamó la atención la cantidad de cepas o variedades de vino
(707), pero únicamente porque superó ampliamente el número
esperado.
La dispersión de precios puede observarse mejor mediante un gráfico:
theme_set(theme_dark() +
theme(plot.background = element_rect(fill = "#555555"),
axis.text = element_text(color = "#222222"),
legend.background = element_rect(fill = "#888888")
))p <- vinos |>
filter(precio <= precio_caro) |>
ggplot() +
geom_histogram(binwidth = 3,
show.legend = FALSE,
aes(x = precio,fill = cut(precio, 100))) +
scale_fill_viridis_d(option = "A", direction = -1) +
labs(title = "Histograma de Precios",
x = "Precio (US$)",
y = "Cantidad de Reseñas")
#ver https://community.rstudio.com/t/geom-histogram-max-bin-height/10026
#ver https://github.com/tidyverse/ggplot2/issues/5004
cuspide <- select(layer_data(p)[which.max(layer_data(p)$y), ],x,y)
# Añade la marca y la nota al pie
p <- p +
geom_text(data = cuspide,
aes(x = x, y = y,
label = paste0("Cúspide\nUS$", x, "\n", y," reseñas")),
nudge_x = 2, nudge_y = -500, color = "#333333", hjust = 0) +
geom_point(data = cuspide,
aes(x = x, y = y),
shape = 20, size = 3, fill = NA, color = "#333333") +
annotate("text", x = Inf, y = Inf, hjust = 1, vjust = 1,
label = paste0("Las reseñas de valores mayores a ",
paste0("$", round(precio_caro,2)), " fueron omitidas."),
color = "#333333") # Nota en la parte superior del área del gráfico
show(p)(los precios mayores a 158 fueron excluidos)
¿Cuántas observaciones hay por cada grupo? ¿Cuántos valores faltantes? ¿Hay diferencias?
Se contabiliza el porcentaje de valores N/A (vacíos), para cada una de las variables:
proporcion <- tibble::rownames_to_column(data.frame(colSums(is.na(vinos))/nrow(vinos)),
"variable")
colnames(proporcion)[2] <- "Cantidad de NA"
proporcion |>
gt() |>
gt_theme_pff() |>
fmt_percent(columns = 2, decimals = 2)| variable | Cantidad de NA |
|---|---|
| pais | 0.05% |
| nombre | 28.83% |
| puntos | 0.00% |
| precio | 6.92% |
| provincia | 0.05% |
| region_1 | 16.35% |
| region_2 | 61.14% |
| variedad | 0.00% |
| vina | 0.00% |
| titulo_resena | 0.00% |
Pueden encontrarse bastantes valores faltantes, pero únicamente en
las columnas de nombre (28.83%), region_1
(16.35%) y region_2 (61.14%).
Se presentan 3 hipótesis:
Podría existir una diferencia notable entre el promedio de precios de los vinos según el país.
Para analizar esto, primero, se realiza un gráfico para ver los promedios de precio x país:
# https://sebastiansauer.github.io/figure_sizing_knitr/
paleta_pais <- createPalette(43, c("#ff0000", "#00ff00", "#0000ff")) # paleta personalizada
vinos |>
filter(!is.na(pais)) |>
group_by(pais) |>
summarise(precio_promedio = mean(precio, na.rm = TRUE)) |>
filter(!is.na(precio_promedio)) |>
ggplot(aes(precio_promedio, reorder(pais, precio_promedio))) +
geom_col(width = 0.5, alpha = 0.6, show.legend = FALSE,
aes(fill = reorder(pais, precio_promedio),
color=reorder(pais, precio_promedio))) +
scale_fill_viridis_d(aesthetics = c("colour", "fill")) +
scale_x_continuous(expand = c(0.01,0)) +
# scale_colour_manual(values = paleta_pais,aesthetics = c("colour", "fill")) + #no logré que funcione
labs(title = "Precio promedio de los vinos por pais",
subtitle = "Listado completo",
x = "Precio", y = "Pais")Se ve una gran dispersión, con precios que van desde menos de US$10 (Ucrania), hasta más de US$85 (Suiza).
Para verificar que estos promedios sean estadísticamente significativos, se analiza cuantas reseñas hay de cada pais:
vinos |>
filter(!is.na(pais)) |>
group_by(pais) |>
summarise(resenias = n()) |>
arrange(resenias) |>
head(10) |>
gt() |>
tab_header(title = "Paises con menos reseñas") |>
cols_label(pais = "País", resenias = "Reseñas") |>
gt_theme_dark()| Paises con menos reseñas | |
| País | Reseñas |
|---|---|
| China | 1 |
| Egipto | 1 |
| Eslovaquia | 1 |
| Armenia | 2 |
| Bosnia y Herzegovina | 2 |
| Luxemburgo | 6 |
| Suiza | 7 |
| India | 9 |
| Chipre | 11 |
| Macedonia | 12 |
Destacan varios paises casi sin reseñas. Gráficamente:
vinos |>
filter(!is.na(pais)) |>
group_by(pais) |>
summarise(resenias = n()) |>
ggplot(aes(resenias, reorder(pais, resenias))) +
geom_col(width = 0.5, show.legend = FALSE,
aes(color=reorder(pais, resenias),
fill=reorder(pais, resenias),
alpha = 0.6)) +
scale_fill_viridis_d(option = "A",
direction = 1,
aesthetics = c("colour", "fill")) +
scale_x_continuous(expand = c(.01,0)) +
labs(title = "Cantidad de Reseñas por pais",
x = "Reseñas",
y = "Pais")Al existir paises con tan pocas reseñas, conviene filtrarlos o agruparlos:
vinos |>
filter(!is.na(pais)) |>
group_by(pais = fct_lump_prop(pais, 0.001, other_level = "Otros")) |>
summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |>
filter(!is.na(precio_promedio)) |>
ggplot(aes(precio_promedio,
reorder(pais, precio_promedio))) +
geom_col(width = 0.5, show.legend = FALSE,
aes(color=reorder(pais, precio_promedio),
fill=reorder(pais, precio_promedio),
alpha = 0.6)) +
scale_fill_viridis_d(option = "F",
direction = 1,
aesthetics = c("colour", "fill")) +
scale_x_continuous(expand = c(0.01,0)) +
labs(title = "Precio promedio de los vinos por pais",
subtitle = "Versión resumida",
x = "Precio", y = "Pais")Otros = paises con pocas reseñas
(<0,1% del tamaño de la muestra)
Conclusiones: Se constata una diferencia significativa entre los precios promedio según el pais de origen del vino, ya sea contabilizando todos o excluyendo los menos representativos.
Respecto de la cantidad de reseñas, no es posible establecer si es una limitación de la muestra, con mayor acceso o interés en vinos locales (las reseñas de EEUU casi triplican a las del segundo, Francia), si existen menos reseñas por tener menor producción de vino, u otros motivos.
Tampoco es posible determinar los motivos de la variación de precio. Puede suponerse que influya la reputación vitivinícola, el tamaño de las economías (países con economías desarrolladas parecen ocupar los 1ros puestos), u otras causas.
Habría una incremento en el precio promedio del vino conforme su puntaje.
Primeramente, se elabora un gráfico de dispersión de la relación puntaje y precio, eliminando vinos de precios muy altos (> 1000), ya que limitan la utilidad el gráfico:
Este gráfico brinda poca información. Parecería que existen vinos de precio bajo en casi todos los puntajes, y el precio mínimo parece elevarse ligeramente a partir del puntaje 95.
p <- vinos |>
filter(!is.na(puntos)) |>
filter(!is.na(precio)) |>
filter(precio < 1000) |>
ggplot(aes(x=puntos, y=precio, color=precio)) +
scale_y_continuous(labels = scales::dollar_format(suffix = " USD", prefix = "")) +
geom_jitter(show.legend = FALSE) +
# scale_color_gradientn(colors = brewer.pal(5, "YlOrBr")) +
scale_color_viridis_c(option = "F", direction = 1) +
# scale_color_gradient(low="blue", high="red") +
labs(title = "Relación precio-puntaje",
subtitle = "escala lineal",
x = "Puntos", y = "Precio", colour = "Precio")
show(p)Si cambiamos la escala:
q <- vinos |>
filter(!is.na(puntos)) |>
filter(!is.na(precio)) |>
ggplot(aes(x = puntos, y = precio)) +
scale_y_log10(labels = scales::dollar_format(suffix = " USD", prefix = "")) +
geom_jitter(aes(colour = precio), show.legend = FALSE) + # Mover la estética aquí
scale_color_viridis_c(option = "F", direction = 1, trans = "log") +
labs(title = "Relación precio-puntaje",
subtitle = "escala logarítmica",
x = "Puntos", y = "Precio") +
geom_labelsmooth(method = "lm",
formula = y ~ x,
label = "A mayor puntaje, mayor precio", alpha = 0.5,
arrow = arrow())
# stat_smooth(method = "lm",
# formula = y ~ x,
# geom = "smooth",
# color="black")
show(q)Una escala logarítmica permite apreciar mucho mejor la relación existente entre precio y puntaje.
Vamos a comprobar el precio promedio para cada puntaje:
p <- vinos |>
filter(!is.na(puntos)) |>
filter(!is.na(precio)) |>
group_by(puntos) |>
summarise(precio_promedio = mean(precio, na.rm = TRUE)) |>
ggplot(aes(x=puntos, y=precio_promedio, fill=precio_promedio)) +
scale_y_continuous(labels = scales::dollar_format(suffix = " USD", prefix = "")) +
geom_col() +
scale_fill_distiller(palette = "YlGnBu") +
labs(title = "Precio Promedio vs Puntaje",
x = "Puntos", y = "Precio", fill = "Precio (US$)")
show(p)Con esto se aprecia que el precio promedio de los vino se incrementa, pero el crecimiento sigue una tendencia más exponencial que lineal.
También podemos observar como se distribuyen los puntajes:
vinos |>
filter(!is.na(puntos)) |>
filter(!is.na(precio)) |>
group_by(puntos) |>
summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |>
gt() |>
tab_header(title = "Relaciones", subtitle = "Puntos vs Precio Promedio vs Reseñas") |>
cols_label(puntos = "Puntos", precio_promedio = "Precio Promedio", resenias = "Reseñas") |>
fmt_number(col = 2, decimals = 2) |>
gt_theme_dark()| Relaciones | ||
| Puntos vs Precio Promedio vs Reseñas | ||
| Puntos | Precio Promedio | Reseñas |
|---|---|---|
| 80 | 16.37 | 395 |
| 81 | 17.18 | 680 |
| 82 | 18.87 | 1772 |
| 83 | 18.24 | 2886 |
| 84 | 19.31 | 6099 |
| 85 | 19.95 | 8902 |
| 86 | 22.13 | 11745 |
| 87 | 24.90 | 15767 |
| 88 | 28.69 | 16014 |
| 89 | 32.17 | 11324 |
| 90 | 36.91 | 14361 |
| 91 | 43.22 | 10564 |
| 92 | 51.04 | 8871 |
| 93 | 63.11 | 5935 |
| 94 | 81.44 | 3449 |
| 95 | 109.24 | 1406 |
| 96 | 159.29 | 482 |
| 97 | 207.17 | 207 |
| 98 | 245.49 | 69 |
| 99 | 284.21 | 28 |
| 100 | 485.95 | 19 |
vinos |>
filter(!is.na(puntos)) |>
filter(!is.na(precio)) |>
group_by(puntos) |>
summarise(precio_promedio = mean(precio, na.rm = TRUE), resenias = n()) |>
ggplot(aes(x = puntos, y = resenias)) +
geom_col(colour = "violetred4", fill = "violetred4",alpha = 0.3)Se observa que los puntajes parecerían tene una distribución semejante a la normal.
Por último, para relacionar con la hipótesis 1, comparamos puntaje promedio conforme paises:
vinos |>
filter(!is.na(pais)) |>
group_by(pais) |>
summarise(puntos_promedio = mean(puntos, na.rm = TRUE), resenias = n()) |>
filter(resenias > tamanio_muestra/1000) |>
filter(!is.na(puntos_promedio)) |>
ggplot(aes(puntos_promedio, reorder(pais, puntos_promedio))) +
geom_col(width = 0.5, color='orange',fill='orange', alpha = 0.6) +
labs(x = "Puntaje", y = "Pais") +
coord_cartesian(xlim = c(80, 100))Se ve, que al contrario del precio promedio, el puntaje promedio no parecería tiene mucha variabilidad.
Conclusiones: Entendemos que existe una correlación entre el puntaje y el precio, aunque desconocemos si esto puede deberse a un sesgo de quien evalúa (que podría tender a asignar puntajes altos a vinos caros) o a una efectiva correlación entre calidad y precio, ya que hay muchos vinos de bajo precio con alto puntaje.
Existirían variedades que podrían tener un precio promedio significativamente mayor, pero no así su puntaje.
vinos |>
filter(!is.na(variedad)) |>
group_by(variedad) |>
summarise(puntos_promedio = mean(puntos, na.rm = TRUE),
precio_promedio = mean(precio, na.rm = TRUE),
resenias = n()) |>
arrange(resenias) |>
head(10) |>
gt(rowname_col = "variedad") |>
tab_header(title = "Variedades de Vino", subtitle = "Muestra de variedades con escasas Reseñas") |>
tab_stubhead(label = "Variedad") |>
cols_label(puntos_promedio = "Puntaje Promedio",
precio_promedio = "Precio Promedio",
resenias = "Reseñas") |>
gt_theme_dark() | Variedades de Vino | |||
| Muestra de variedades con escasas Reseñas | |||
| Variedad | Puntaje Promedio | Precio Promedio | Reseñas |
|---|---|---|---|
| Aidani | 82 | 27 | 1 |
| Albanello | 86 | 20 | 1 |
| Athiri | 83 | 18 | 1 |
| Babosa Negro | 92 | 45 | 1 |
| Barbera-Nebbiolo | 87 | 30 | 1 |
| Biancale | 85 | 18 | 1 |
| Biancolella | 85 | 26 | 1 |
| Biancu Gentile | 89 | NaN | 1 |
| Blatina | 88 | 12 | 1 |
| Blauburger | 87 | 17 | 1 |
# kable(col.names = c("Variedad", "Puntaje Promedio", "Precio Promedio", "Reseñas")) |>
# kable_styling(full_width = FALSE)Por la cantidad de variedades encontradas (707), y la
escasa cantidad de reseñas de muchas, se agrupan en “Otras” las
variedades sin una cantidad significativa de reseñas.
vinos |>
filter(!is.na(variedad)) |>
group_by(variedad = fct_lump_min(variedad, tamanio_muestra/200, other_level = "Otras")) |>
summarise(puntos_promedio = mean(puntos, na.rm = TRUE),
precio_promedio = mean(precio, na.rm = TRUE),
resenias = n()) |>
## filter(resenias > tamanio_muestra/200) |>
arrange(resenias) |>
ggplot() +
geom_col(aes(-puntos_promedio+80, reorder(variedad, precio_promedio)), width = 0.5, color='purple4',fill='purple4', alpha = 0.6) +
geom_col(aes(precio_promedio, reorder(variedad, precio_promedio)), width = 0.5, color='red4',fill='red4', alpha = 0.6) +
labs(x = "Puntaje - Precio", y = "Variedad")Para este gráfico, se opusieron puntaje a la izquierda (escala de 80 a 100) y precio a la derecha.
Conclusiones: Se estima que el gráfico da cuenta de que existe una diferencia del precio promedio de las variedades más reseñadas, pero que este precio no correlaciona (al menos a simple vista) con el puntaje promedio. Lo anterior podría deberse a varias causas. Una hipótesis es que las variedades o cepas podrían tener un precio promedio distinto en base a los costos de su producción, la dificultad específica de su cultivo, tiempo de procesamiento, o su exclusividad, entre otros.